home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / idvb / idopen.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  4.8 KB  |  159 lines
  1. VERSION 2.00
  2. Begin Form IDOPEN 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "DlgDirList File Open"
  5.    ClientHeight    =   2490
  6.    ClientLeft      =   2670
  7.    ClientTop       =   1845
  8.    ClientWidth     =   4875
  9.    Height          =   2895
  10.    Left            =   2610
  11.    LinkMode        =   1  'Source
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   2490
  16.    ScaleWidth      =   4875
  17.    Top             =   1500
  18.    Width           =   4995
  19.    Begin ListBox DList 
  20.       Height          =   1395
  21.       Left            =   2040
  22.       TabIndex        =   7
  23.       Top             =   850
  24.       Width           =   1455
  25.    End
  26.    Begin ListBox FList 
  27.       Height          =   1395
  28.       Left            =   240
  29.       TabIndex        =   5
  30.       Top             =   850
  31.       Width           =   1575
  32.    End
  33.    Begin CommandButton OkCancel 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "Cancel"
  36.       Height          =   375
  37.       Index           =   1
  38.       Left            =   3735
  39.       TabIndex        =   3
  40.       Top             =   675
  41.       Width           =   975
  42.    End
  43.    Begin CommandButton OkCancel 
  44.       Caption         =   "OK"
  45.       Default         =   -1  'True
  46.       Height          =   375
  47.       Index           =   0
  48.       Left            =   3720
  49.       TabIndex        =   2
  50.       Top             =   180
  51.       Width           =   975
  52.    End
  53.    Begin Label Label5 
  54.       Caption         =   "&Directories:"
  55.       Height          =   255
  56.       Left            =   2040
  57.       TabIndex        =   6
  58.       Top             =   600
  59.       Width           =   1095
  60.    End
  61.    Begin Label Label4 
  62.       Caption         =   "&Files:"
  63.       Height          =   255
  64.       Left            =   240
  65.       TabIndex        =   4
  66.       Top             =   600
  67.       Width           =   615
  68.    End
  69.    Begin Label PName 
  70.       Height          =   195
  71.       Left            =   1200
  72.       TabIndex        =   1
  73.       Top             =   240
  74.       Width           =   2355
  75.    End
  76.    Begin Label Label2 
  77.       Caption         =   "Directory:"
  78.       Height          =   255
  79.       Left            =   240
  80.       TabIndex        =   0
  81.       Top             =   240
  82.       Width           =   855
  83.    End
  84. DefInt A-Z
  85. Declare Function DlgDirList Lib "User" (ByVal hDlg As Integer, ByVal lpPathSpec As String, ByVal nIDListBox As Integer, ByVal nIDStaticPath As Integer, ByVal wFiletype As Integer) As Integer
  86. Declare Function DlgDirSelect Lib "User" (ByVal hDlg As Integer, ByVal lpString As String, ByVal nIDListBox As Integer) As Integer
  87. Declare Function SetErrorMode Lib "Kernel" (ByVal wMode As Integer) As Integer
  88. ' IDs of the controls we'll be needing
  89. Const IDS_PATH = 3
  90. Const IDL_FLIST = 7
  91. Const IDL_DLIST = 8
  92. ' search spec
  93. Const sFileSpec = "*.*"
  94. ' last change flags
  95. Const FListBox = 1
  96. Const DListBox = 2
  97. ' iChange holds the last change flag
  98. Dim iChange As Integer
  99. '  sCurDir holds the most recent directory
  100. Dim sCurDir As String
  101. Sub DList_Click ()
  102.     iChange = DListBox
  103. End Sub
  104. Sub DList_DblClick ()
  105.     ' Prepare a buffer to hold the new directory
  106.     aDir$ = String$(15, 0)
  107.     ' get the new directory
  108.     Ok = DlgDirSelect(IDOPEN.hWnd, aDir$, IDL_DLIST)
  109.     ' get rid off the Chr$(0)s
  110.     aDir$ = Left$(aDir$, InStr(aDir$, Chr$(0)) - 1)
  111.     ' let Windows handle the errors, e.g. drive not ready, etc
  112.     iErrMode = SetErrorMode(0)
  113.     ' perform the changes
  114.     Ok = DlgDirList(IDOPEN.hWnd, (aDir$ + sFileSpec), IDL_FLIST, IDS_PATH, 0)
  115.     Ok = DlgDirList(IDOPEN.hWnd, "*.*", IDL_DLIST, 0, &HC010)
  116.     ' give error control back to us
  117.     iErrMode = SetErrorMode(1)
  118.     ' save the directory change
  119.     sCurDir = LCase$(MakePath$(CurDir$))
  120. End Sub
  121. Sub FList_Click ()
  122.     iChange = FListBox
  123. End Sub
  124. Sub FList_DBlClick ()
  125.     ' if there is a selection, retrieve it and change the IDDEMO
  126.     ' FName caption to show the full selection
  127.     If FList.ListIndex <> -1 Then
  128.     IDDEMO.FName.Caption = sCurDir + FList.List(FList.ListIndex)
  129.     IDOPEN.Hide
  130.     End If
  131. End Sub
  132. Sub Form_Load ()
  133.     ' fill the listboxes (wFileSpec is set to 0 for normal files)
  134.     Ok = DlgDirList(IDOPEN.hWnd, sFileSpec, IDL_FLIST, IDS_PATH, 0)
  135.     Ok = DlgDirList(IDOPEN.hWnd, "*.*", IDL_DLIST, 0, &HC010)
  136.     ' save the current directory
  137.     sCurDir = LCase$(MakePath$(CurDir$))
  138. End Sub
  139. Function MakePath$ (aPath$)
  140.     If Right$(aPath$, 1) <> "\" Then
  141.     MakePath$ = aPath$ + "\"
  142.     Else
  143.     MakePath$ = aPath$
  144.     End If
  145. End Function
  146. Sub OkCancel_Click (Index As Integer)
  147.     If Index = 0 Then
  148.     Select Case iChange
  149.         Case DListBox
  150.         DList_DblClick
  151.         Case FListBox
  152.         FList_DBlClick
  153.         Case Else
  154.     End Select
  155.     Else
  156.     IDOPEN.Hide
  157.     End If
  158. End Sub
  159.